perm filename FILLER.F4[CMS,LCS]2 blob
sn#103186 filedate 1974-05-24 generic text, type T, neo UTF8
00100 C Q AND R ARE X,Y COORDS. NE(1)=WDCNT. OTHER NE'S HAVE 3
00200 C FOR INVIS. VECTORS. M=VERTICAL SCAN LINES
00300 SUBROUTINE FILLER(Q,R,NE,M,LP,IT,LD,LS)
00400 DIMENSION Q(1),R(1),NE(1)
00500 KK=NE(1)
00600 NX=-10000
00700 JN=NX
00800 KJ=2
00900 DO 4 K=2,KK
01000 IF(NE(K).NE.3)GO TO 11
01100 NE(K)=KJ
01200 KJ=K+1
01300 GO TO 4
01400 11 NE(K)=0
01500 4 CONTINUE
01600 DO 12 K=1,KK
01700 Q(K)=IFIX(Q(K))
01800 12 R(K)=IFIX(R(K))
01900 NE(KK+1)=KJ
02000 C FINDS JUMPS
02100 DO 2 J=2,KK
02200 IF(NE(J).GT.0.OR.Q(J).EQ.Q(J-1))GO TO 2
02300 C SKIPS VERTICAL LINES
02400 XMID=HALF(Q,J)+.00001
02500 C MIDPOINT OF LINE
02600 ALT=HALF(R,J)
02700 C THE ALTITUDE
02800 KJ=0
02900
03000 100 DO 3 L=2,KK
03100 IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
03200 C NEXT FINDS LINE OVERLAP
03300 IF(MISS(L,XMID,Q))GO TO 3
03400 C NEXT FINDS ALT. OF CROSSING
03500 40 Y=HGHT(L,XMID,Q,R)
03600 IF(Y.LT.ALT)KJ=KJ+1
03700 3 CONTINUE
03800
03900 IF(MOD(KJ,2).EQ.0)GO TO 2
04000 C NEXT IF FOUND A LINE TO DRAW LINES DOWN FROM.
04100 NE(J)=-1
04200 KJ=M
04300 N=Q(J)
04400 L=Q(J-1)
04500 CC IF(IABS(N-L).LE.M)GO TO 2
04600 C SKIPS SEGS SHORTER THAN M INCREMENT.
04700 ALT=.0001
04800 IF(N.GT.L)GO TO 33
04900 KJ=-KJ
05000 ALT=-ALT
05100 33 IF(L.EQ.NX.AND.JN.EQ.J-1)GO TO 17
05200 JA=3
05300 X=-1
05400 17 NX=N
05500 JN=J
05600 K=IABS(MOD(L,KJ))
05700 IF(L.LE.0.OR.KJ.LE.0)GO TO 221
05800 L=L+KJ-K
05900 GO TO 222
06000 221 IF(.NOT.L.OR.KJ.LE.0)GO TO 220
06100 L=L+K
06200 GO TO 222
06300 220 IF(.NOT.L.OR..NOT.KJ)GO TO 219
06400 L=L+KJ+K
06500 GO TO 222
06600 219 IF(.NOT.KJ.OR.L.LE.0)GO TO 222
06700 L=L-K
06800 222 IF(L.GT.N.AND.KJ.GT.0)GO TO 2
06900 IF(L.LT.N.AND.KJ)GO TO 2
07000 DO 6 K=L,N,KJ
07100 RK=K
07200 XK=RK
07300 IF(K.EQ.N)ALT=-ALT
07400 C NO SHIFT AT LAST POSITION
07500 RK=RK+ALT
07600 Y=HGHT(J,RK,Q,R)
07700 IF(X)CALL LINES(XK,Y,JA,LP,IT,LS,LD)
07800 JA=2
07900 H=-10000
08000
08100 18 DO 7 I=2,KK
08200 IF(NE(I).NE.0)GO TO 7
08300 C SKIP IF SAME LINE.
08400 IF(MISS(I,RK,Q))GO TO 7
08500 C TRY NEXT POINT IF IT HIT A -1 LINE.
08600 9 B=HGHT(I,RK,Q,R)
08700 IF(B.GT.Y)GO TO 7
08800 IF(B.LE.H)GO TO 7
08900 H=B
09000 IX=I
09100 C FOUND HIGHEST NEW POINT
09200 7 CONTINUE
09300 IF(H.EQ.Y)GO TO 31
09400 C WIPES OUT THIS LINE SEG.
09500 IF(H.NE.-10000)GO TO 31
09600 NX=-10000
09700 C*** X=1
09800 X=-1
09900 GO TO 6
10000 31 IF(IX.NE.JX.AND.X.GT.0)JA=3
10100 JX=IX
10200 CALL LINES(XK,H,JA,LP,IT,LS,LD)
10300 JA=2
10400 IF(X.GT.0)CALL LINES(XK,Y,JA,LP,IT,LS,LD)
10500 X=-X
10600 6 CONTINUE
10700 2 CONTINUE
10800 RETURN
10900 END
11000
11100 FUNCTION HGHT(J,A,Q,R)
11200 DIMENSION Q(1),R(1)
11300 B=R(J-1)
11400 D=Q(J-1)
11500 F=Q(J)
11600 HGHT=((R(J)-B)*(A-D))/(F-D)+B
11700 IF(F.EQ.D)HGHT=B
11800 END
11900
12000 FUNCTION MISS(J,A,Q)
12100 DIMENSION Q(1)
12200 B=Q(J)
12300 C=Q(J-1)
12400 MISS=-1
12500 IF((A.LT.C.AND.A.GT.B).OR.(A.LT.B.AND.A.GT.C))MISS=0
12600 END
12700 C MISS=-1, HIT=0
12800
12900 FUNCTION HALF(A,J)
13000 DIMENSION A(1)
13100 HALF=(A(J-1)-A(J))/2.+A(J)
13200 END
13300
13400 SUBROUTINE LINES(A,B,J,I,IT,L,LD)
13500 M=A
13600 N=B
13700 IF(IT.LT.11)GO TO 41
13800 M=B
13900 N=A
14000 IF(L.AND.N.NE.LY)J=3
14100 11 IF(.NOT.I)GO TO 2
14200 IF(J.EQ.3)GO TO 1
14300 CALL AVECT(M,N)
14400 RETURN
14500 1 CALL AIVECT(M,N)
14600 RETURN
14700 41 IF(L.AND.M.NE.LX)J=3
14800 GO TO 11
14900 2 IF(J.EQ.3.OR..NOT.LD)GO TO 42
15000 NI=2
15100 IF(IT.GT.10)GO TO 44
15200 MI=IT*1.3
15300 IF(LY.LT.N)GO TO 46
15400 MI=-MI
15500 NI=-NI
15600 46 MD=MI
15700 IF(J.EQ.4)J=2
15800 IF(J.EQ.2)MD=NI
15900 LY=LY+MD
16000 IF(MI.AND.LY.LT.N)GO TO 42
16100 IF(.NOT.MI.AND.LY.GT.N)GO TO 42
16200 47 CALL PLOT(LX,LY,J)
16300 J=J+1
16400 IF(IT.GT.10)GO TO 43
16500 GO TO 46
16600 44 MI=(IT-10)*1.3
16700 IF(LX.LT.M)GO TO 43
16800 MI=-MI
16900 NI=-NI
17000 43 MD=MI
17100 IF(J.EQ.4)J=2
17200 IF(J.EQ.2)MD=NI
17300 LX=LX+MD
17400 IF(MI.AND.LX.LT.M)GO TO 42
17500 IF(.NOT.MI.AND.LX.GT.M)GO TO 42
17600 GO TO 47
17700 42 CALL PLOT(M,N,J)
17800 LX=M
17900 LY=N
18000 END